Full screen editor in forth-83. Based upon Henry 16mar86 rfbLaxen's original. Highly taylored for IBM pc. NO SHADOWS ***********************************Craig A. Lindley ** Hacked slightly to add shadow Clockwork Software ** Support, a new screen format, 6 Sutherland Place ** Auto-id, time/date & a modest Manitou Springs, Co. 80829 ** Display speedup. rfb(303) 685-1786 after 5 P.M. ***********************************Distributed by FIG Librarian (Please send updates) John A. Peters Phone (415) 239-5393 121 Santa Rosa Ave. 8-9 am or after 7 pm San Francisco, CA 94112 or week ends. or Computer Language Mag. BBS (415) 957-9370 300/1200 (Files)or Forth Interest Group Tree BBS (415) 538-3580 300 bps (Text) \ screen editor 119AUG86JEB\ Title Basic_System warning off \ defeat error messages 1 34 +thru \ load the editor cr .( Full Screen Editor Loaded ) only forth also definitions warning on \ error messages back on \s This is another full screen editor program. it is written (almost; rfb) entirely in high level forth. It is more convenient to use in many cases than the starting forth editor. If you wish to make it a part of your system type: here fence ! \ if you wish to protect editor save-system f83.com \ overwrites previous system \ screen editor - case statement cl 06/28/84vocabulary edit edit also definitions : ?comp state @ not abort" compilation only" ; : ?pairs <> abort" bad case statement" ; : case ?comp csp @ !csp 4 ; immediate : of 4 ?pairs compile over compile = compile ?branch here 0 , compile drop 5 ; immediate : endof 5 ?pairs compile branch here 0 , swap >resolve 4 ; immediate : endcase 4 ?pairs compile drop begin sp@ csp @ <> while >resolve repeat csp ! ; immediate \ screen editor 16mar86 rfb variable &mode variable &cur \ var declaration variable &badr variable &upd variable &status variable &tag1 variable &tag2 variable &id 12 allot &id 12 blank \ id field cleared 1024 constant cps 16 constant lps \ const. declaration 8 constant %x 4 constant %y \ x and y offsets : pad1 pad 84 + ; \ text save area : pad2 pad1 84 + ; \ # input area \ 16mar86 rfb \ screen editor : use bios call for speed 16mar86 rfb code bios ax pop al ah mov dx pop dl al mov 16 int ah ah xor 1push end-code \ screen editor-fast char output using bios 16mar86 rfb : nemit 14 bios drop 1 #out +! ; \ hook for faster emit \ replaces 6 bdos .... : ntype 0 ?do count nemit loop drop ; \ hook for faster type : nspaces 0 ?do bl nemit loop ; \ hook for faster spaces : nblot 72 swap - nspaces ; \ only blank inside window \ Months and Days from CLOCK.BLK 16mar86 rfb : "ARRAY ( compile: string-length -- ) ( run: -- a n ) CREATE C, ASCII " WORD COUNT >R HERE R@ MOVE R> ALLOT DOES> COUNT >R SWAP R@ * + R> ; 3 "ARRAY "MONTH "JanFebMarAprMayJunJulAugSepOctNovDec" 3 "ARRAY "DAY "SunMonTueWedThuFriSat" 3 "ARRAY "mon "janfebmaraprmayjunjulaugsepoctnovdec" \ for id \ IBM-PC Time/Date Support by Ray Jones 16mar86 rfb hex code call-date ax pop 21 int ax pop cx push dl al xchg ax push dh al xchg ax push next end-code code call-time ax pop 21 int ax pop al ch xchg ax push cl al xchg ax push next end-code : (date) 0 2a00 call-date ; : date (date) swap . 1- "month type space . ; : time 0 2c00 call-time swap 0 <# #s #> type ." :" dup 0A < if ." 0" then . ; : now ." Date: " date 2 nspaces ." Time: " time ; decimal \ screen editor Auto-ID 120AUG86JEB : (who) " jeb" ; \ change to suit : nnum <# # # #> ; : set-id (date) swap 0 nnum &id swap cmove \ day 1- "mon &id 2 + swap cmove \ month 0 nnum &id 5 + swap cmove \ year (who) &id 8 + swap cmove \ usr-id hello ; ' set-id is boot : ?id &id 11 type cr ; \ screen editor cl 06/28/84: >line# c/l / ; \ convert char pos to line # : line#> c/l * ; \ convert line # to char pos : curpos &cur @ ; \ get cursor position : +cur &cur +! curpos \ adv cur and chk bounds 0 max 1023 min &cur ! ; : mvcur +cur curpos c/l /mod \ move the cursor %y + swap %x + swap at ; \ to pos on tos : bufadr &badr @ + ; \ conv cur pos to buf addr : bufpos curpos bufadr ; \ rets address in disk buf \ of char at cur pos \ screen editor 16mar86 rfb: upd 1 &upd ! ; \ set update flag : ?prt dup bl < swap 126 > or 0= ; \ chk char on tos \ rets true if printable : mark &upd @ if 0 &upd ! \ if block changed update &id 0 bufadr c/l + 11 - 11 \ line 0 cmove update then ; : #toeol c/l mod c/l swap - ; \ # chars to eol : clreol curpos >line# line#> - \ clear to end of line 8 + nblot ; : position 36 2 2dup at 36 nblot at ; \ command display pos \ screen editor 16mar86 rfb : key key ?dup 0= if key 128 + then ; \ new keyboard routine : bufmv rot bufadr rot bufadr \ move disk buffer rot move upd ; \ @ cursor position : distoeol dup bufadr over \ displays rest of line #toeol -trailing \ from cur pos rot over + >r ntype r> clreol ; : ?empty line#> bufadr c/l \ line # --- f -trailing swap drop 0= ; \ rets true if line empty \ screen editor 16mar86 rfb: prnt position ." Printing" \ print on line printer ['] (semit) is emit \ select lp as list device printing on \ turn printing on space cr space cr space cr \ 3 blanks lines between scr @ list \ list to printer ['] (emit) is emit \ select crt as list device printing off \ turn printing off key? if key drop then ; \ if abort consume key : distoeos curpos swap lps swap \ display screen from line do i line#> dup &cur ! \ # on tos to end 0 mvcur distoeol loop &cur ! 0 mvcur ; \ screen editor cl 06/28/84: exp dup dup c/l + cps over - \ insert blank line at bufmv bufadr c/l blank ; \ pos on tos : shrink dup c/l + swap over cps \ del line at pos swap - bufmv 15 line#> \ add blank line 15 bufadr c/l blank ; : insertline 15 ?empty \ adds line to screen if dup exp >line# distoeos \ if line 15 is empty else beep then ; \ else just beeps : deleteline >line# dup line#> \ del line at pos shrink distoeos ; \ on tos \ screen editor cl 06/28/84: inschar dup dup 1+ over #toeol \ insert char into buf 1 - bufmv bufadr c! ; : delchar dup dup 1+ swap over \ del char at cursor #toeol bufmv dup #toeol + 1- bufadr bl swap c! ; : rarrow 1 +cur ; \ cursor right one : larrow -1 +cur ; \ cursor left one : uarrow c/l negate +cur ; \ cursor up one : darrow c/l +cur ; \ cursor down one : iline curpos insertline ; \ insert line at cur : dline curpos deleteline ; \ delete line at cur \ screen editor 16mar86 rfb: dchar curpos delchar curpos \ delete char at cursor distoeol ; : imode 1 &mode ctoggle \ toggle insert mode flag 1 &status ! ; : heading dark \ heading titles 8 0 at ." Editing: " file? 41 0 at now ; : titles 8 2 2dup at 8 nblot at ." Screen: " 21 2 at ." State: " 37 2 at ." Mode: " 54 2 at ." Line: " 64 2 at ." Char: " 15 23 at ." VED-86 Mod: 2.3 <ESC> H for Help " ; \ screen editor 15mar86 rfb: ret &mode @ if iline else \ insert mode insert line curpos >line# 1+ 15 min \ if not just do return line#> &cur ! then ; : quited dark forth cr \ quit, no save ." Edit Complete: " file? cr cr ." ok" sp0 @ sp! quit ; \ stack and executes quit : exitupd mark save-buffers quited ; \ save screens before \ quiting editor \ screen editor 16mar86 rfb : #in pad2 1+ 20 2dup blank expect \ input a # from the user span @ pad2 c! pad2 number drop ; \ to the tos : dupblock position \ duplicate block at ." Duplicate block #: " #in ?dup \ specified location if scr @ swap copy then ; \ answer 0 then abort : deltoeos bufpos dup &badr @ - \ delete from cursor to 1+ cps swap - blank curpos >line# distoeos upd ; \ the end of the display \ screen editor 15mar86 rfb: scan+= 2dup = if drop drop drop 0 else 0 rot rot do over i c@ = if leave else 1+ then loop swap drop then ; : scan+<> 2dup = if drop drop drop 0 else 0 rot rot do over i c@ <> if leave else 1+ then loop swap drop then ; : scan-= 2dup = if drop drop drop 0 else 0 rot rot do over i c@ = if leave else 1 - then -1 +loop swap drop then ; : scan-<> 2dup = if drop drop drop 0 else 0 rot rot do over i c@ <> if leave else 1 - then -1 +loop swap drop then ; \ screen editor cl 06/28/84: mvlwrd bl 0 bufadr bufpos \ move left a word scan-= >r bl 0 bufadr \ rets # of chars to move cur bufpos r@ + s
